home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_1
/
fd200.zip
/
FD_AVL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-02-27
|
5KB
|
209 lines
function modestr(s : mode): any_string;
begin
case s of
CW : modestr := 'CW';
AM : modestr := 'AM';
FM : modestr := 'FM';
SSB : modestr := 'SB';
RTTY : modestr := 'RY';
AMTOR : modestr := 'MT';
PACKET : modestr := 'PK';
end;
end;
function pmodstr(s : mode): any_string;
begin
case s of
CW : pmodstr := ' CW';
AM : pmodstr := ' AM';
FM : pmodstr := ' FM';
SSB : pmodstr := ' SSB';
RTTY : pmodstr := ' RTTY';
AMTOR : pmodstr := ' AMTOR';
PACKET : pmodstr := 'PACKET';
end;
end;
function bandstr(b : hamband): any_string;
begin
case b of
B160 : bandstr := '160';
B80 : bandstr := ' 80';
B40 : bandstr := ' 40';
B20 : bandstr := ' 20';
B15 : bandstr := ' 15';
B10 : bandstr := ' 10';
B6 : bandstr := ' 6';
B2 : bandstr := ' 2';
B220 : bandstr := '220';
B440 : bandstr := '440';
end;
end;
function check_mode(mode1, mode2 : mode): integer;
begin
case mode1 of
CW, RTTY, AMTOR : case mode2 of
CW, RTTY, AMTOR : check_mode := 0;
AM, FM, SSB, PACKET : check_mode := 1;
end;
AM, FM, SSB : case mode2 of
CW, RTTY, AMTOR : check_mode := -1;
AM, FM, SSB : check_mode := 0;
PACKET : check_mode := 1;
end;
PACKET : case mode2 of
PACKET : check_mode := 0;
else check_mode := -1;
end;
end;
end;
function cmp;
begin
if (d1.callsign < d2.callsign)
then cmp := -1
else if (d1.callsign > d2.callsign)
then cmp := 1
else if (d1.band < d2.band)
then cmp := -1
else if (d1.band > d2.band)
then cmp := 1
else cmp := check_mode(d1.xmtmode,d2.xmtmode);
end;
procedure print;
var pkey : char;
begin
with pdata do
begin
line_nbr := line_nbr + 1;
gotoxy(14,line_nbr);
writeln(callsign:6,
class:5,
pmodstr(xmtmode):7,
bandstr(band):4,
section: 15,
date:9,time:6);
end;
if line_nbr = 23 then
begin
gotoxy(14,24);
write('<ESC>ape to quit print, <Retrn> for next page ..');
repeat pkey := readkey until pkey in [#13,#27];
if pkey = #27 then escape := TRUE;
ClrScr;
line_nbr := 0;
end;
end;
procedure fprint;
begin
with pdata do
writeln(fd_file,callsign:6,
class:3,
modestr(xmtmode):2,
bandstr(band):3,
section: 14,
date:8,time:5);
end;
procedure read_file;
var filename : file_type;
source : any_string;
point,i,error : integer;
fd_file : text;
p : LINK;
procedure read_line;
var tstr : string[2];
bstr : string[3];
begin
with p^.leaf do
begin
readln(fd_file,callsign, class, tstr, bstr, section, date, time);
if tstr = 'PK' then xmtmode := PACKET
else if tstr = 'MT' then xmtmode := AMTOR
else if tstr = 'RY' then xmtmode := RTTY
else if tstr = 'SB' then xmtmode := SSB
else if tstr = 'FM' then xmtmode := FM
else if tstr = 'AM' then xmtmode := AM
else xmtmode := CW;
if bstr = '160' then band := B160
else if bstr = ' 80' then band := B80
else if bstr = ' 40' then band := B40
else if bstr = ' 20' then band := B20
else if bstr = ' 10' then band := B10
else if bstr = ' 6' then band := B6
else if bstr = ' 2' then band := B2
else if bstr = '220' then band := B220
else band := B440;
end;
add_to_score(p^.leaf);
insert(root,p);
end;
begin
get_file_name(filename,1,1,default_file,1,1,80,24);
if (filename = '') then filename := default_file;
default_file := filename;
assign(fd_file,filename);
{$I-}
reset(fd_file);
if (IOresult <> 0)
then
begin
ClrScr;
writeln('File not found');
writeln;
write('Press any key to continue..');
wait_for_key;
ClrScr;
end
else
begin
writeln;
while (NOT Eof(fd_file)) do
begin
p := talloc;
if (p <> NIL) then read_line;
end;
end;
close(fd_file);
end;
procedure write_file(root: LINK);
var filename : file_type;
i : integer;
begin
escape := FALSE;
for i := 0 to 1023 do map[i] := 0;
depth := -1;
window(1,1,80,24);
ClrScr;
get_file_name(filename,1,1,default_file,1,1,80,24);
if (filename = '') then filename := default_file;
assign(fd_file,filename);
{$I-}
rewrite(fd_file);
i := IOresult;
if (i <> 0)
then
begin
writeln; writeln('Unable to open file ',filename,' - error = ',i);
write('Press any key to continue ...');
wait_for_key;
{$I-}
close(fd_file);
i := IOresult;
end
else
begin
writeln; write('Writing records ...');
trav( root, R, 1);
close(fd_file);
end;
window(1,1,80,25);
end;